home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IOInterface / commonDef.icl < prev    next >
Encoding:
Modula Implementation  |  1995-03-10  |  6.6 KB  |  325 lines  |  [TEXT/3PRM]
  1. implementation module commonDef;
  2.  
  3.  
  4. //
  5. //    Common types for the event I/O system:
  6. //
  7.  
  8.  
  9. import    StdEnv;
  10. from    mac_types        import Rect, WindowPtr, Toolbox;
  11. from    quickdraw        import QGetPort, QSetPort, GrafPtr, QLocalToGlobal, QGlobalToLocal;
  12. from    deltaPicture    import Rectangle, Point;
  13.  
  14.  
  15. ::    ItemTitle        :==    String;
  16.  
  17. ::    SelectState        =    Able | Unable;
  18. ::    MarkState        =    Mark | NoMark;
  19.  
  20. ::    KeyboardState    :==    (!KeyCode, !KeyState, !Modifiers);
  21. ::    KeyCode            :==    Char;
  22. ::    KeyState        =    KeyUp | KeyDown | KeyStillDown;
  23.  
  24. ::    MouseState        :==    (!MousePosition, !ButtonState, !Modifiers);
  25. ::    MousePosition    :==    (!Int, !Int);
  26. ::    ButtonState     =    ButtonUp | ButtonDown
  27.                     |    ButtonDoubleDown | ButtonTripleDown | ButtonStillDown;
  28.  
  29. ::    Modifiers        :==    (!Bool, !Bool, !Bool, !Bool);
  30. ::    PictureDomain    :==    Rectangle;
  31.  
  32.  
  33.  
  34. SelectStateEqual :: !SelectState !SelectState -> Bool;
  35. SelectStateEqual Able   Able    = True;
  36. SelectStateEqual Unable Unable    = True;
  37. SelectStateEqual _        _        = False;
  38.  
  39. MarkEqual :: !MarkState !MarkState -> Bool;
  40. MarkEqual Mark        Mark    = True;
  41. MarkEqual NoMark    NoMark    = True;
  42. MarkEqual _            _        = False;
  43.  
  44. ButtonStateEqual :: !ButtonState !ButtonState -> Bool;
  45. ButtonStateEqual ButtonUp            ButtonUp        = True;
  46. ButtonStateEqual ButtonDown         ButtonDown         = True;
  47. ButtonStateEqual ButtonStillDown    ButtonStillDown    = True;
  48. ButtonStateEqual _                    _                = False;
  49.  
  50. Enabled    :: !SelectState -> Bool;
  51. Enabled Able    = True;
  52. Enabled Unable    = False;
  53.  
  54. Checked    :: !MarkState -> Bool;
  55. Checked Mark    = True;
  56. Checked NoMark    = False;
  57.  
  58. MarkSwitch :: !MarkState -> MarkState;
  59. MarkSwitch Mark        = NoMark;
  60. MarkSwitch NoMark    = Mark;
  61.  
  62. /*    Convert a KeyMap (returned by GetKeys) into Modifiers (four booleans). */
  63.  
  64. KeyMapToModifiers :: !(!Int,!Int,!Int,!Int) -> Modifiers;
  65. KeyMapToModifiers (_,word,_,_)
  66.     =    (IntToBool shift, IntToBool option, IntToBool command, IntToBool control);
  67.     where {
  68.         shift    = word bitand ShiftMask;
  69.         option    = word bitand OptionMask;
  70.         command    = word bitand CommandMask;
  71.         control    = word bitand ControlMask;
  72.     };
  73.  
  74. IntToBool :: !Int -> Bool;
  75. IntToBool 0 = False;
  76. IntToBool _ = True;
  77.  
  78. /*    Conversion of modifiers as found in events. */
  79.  
  80. ModifiersToINT :: !Modifiers -> Int;
  81. ModifiersToINT (shift, option, command, control)
  82.     =     Mask shift        512        bitor
  83.         (Mask option    2048    bitor
  84.         (Mask command    256        bitor
  85.          Mask control    4096));
  86.  
  87. Mask :: !Bool !Int -> Int;
  88. Mask b n    |    b    = n;
  89.                     = 0;
  90.  
  91. INTToModifiers    :: !Int -> Modifiers;
  92. INTToModifiers flags
  93.     =    (FlagIsSet flags 512, FlagIsSet flags 2048, FlagIsSet flags 256, FlagIsSet flags 4096);
  94.  
  95. FlagIsSet flags flag    :== (flags bitand flag) <> 0;
  96.  
  97. ShiftMask                :== 1;
  98. OptionMask                :== 4;
  99. CommandMask                :== 32768;
  100. ControlMask                :== 8;
  101.  
  102.  
  103. /*    Control structure rules: */
  104.  
  105. InGrafport :: !WindowPtr !(Toolbox -> (x, Toolbox)) !Toolbox -> (!x, !Toolbox);
  106. InGrafport wPtr f tb
  107.     =    (x, tb4);
  108.     where {
  109.         (port,tb1)    = QGetPort tb;
  110.         tb2            = QSetPort wPtr tb1;
  111.         (x,    tb3)    = f tb2;
  112.         tb4            = QSetPort port tb3;
  113.     };
  114.  
  115. InGrafport2 :: !WindowPtr !(Toolbox -> Toolbox) !Toolbox -> Toolbox;
  116. InGrafport2 wPtr f tb
  117.     =     tb4;
  118.     where {
  119.         (port,tb1)    = QGetPort tb;
  120.         tb2            = QSetPort wPtr tb1;
  121.         tb3            = f tb2;
  122.         tb4            = QSetPort port tb3;
  123.     };
  124.  
  125.  
  126. LocalToGlobal :: !Point !Toolbox -> (!Point,!Toolbox);
  127. LocalToGlobal (x,y) tb
  128.     =    ((x1,y1), tb1);
  129.     where {
  130.         (x1,y1,tb1) = QLocalToGlobal x y tb;
  131.     };
  132.  
  133. GlobalToLocal :: !Point !Toolbox -> (!Point,!Toolbox);
  134. GlobalToLocal (x,y) tb
  135.     =    ((x1,y1), tb1);
  136.     where {
  137.         (x1,y1,tb1) = QGlobalToLocal x y tb;
  138.     };
  139.  
  140. If :: !Bool x x -> x;
  141. If b then else    | b    = then;
  142.                     = else;
  143.  
  144.  
  145. /*    Calculation rules on Integers: */
  146.  
  147. ABS :: !Int -> Int;
  148. ABS x        |    x >= 0                = x;
  149.                                     = 0 - x;
  150.  
  151. Dist :: !Int !Int -> Int;
  152. Dist x y    |    d >= 0                = d;
  153.                                     = 0 - d;
  154.     where {
  155.         d = x - y;
  156.     };
  157.  
  158. Min :: !Int !Int -> Int;
  159. Min m n        |    m <= n                = m;
  160.                                     = n;
  161.  
  162. Max :: !Int !Int -> Int;
  163. Max m n        |    m >= n                = m;
  164.                                     = n;
  165.  
  166. SetBetween :: !Int !Int !Int -> Int;
  167. SetBetween x low up
  168.             |    x <= low            = low;
  169.             |    x >= up                = up;
  170.                                     = x;
  171.  
  172. IsBetween :: !Int !Int !Int -> Bool;
  173. IsBetween x low up = x >= low && x <= up;
  174.  
  175.  
  176. /*    Calculation rules on Reals:
  177. */
  178.  
  179. ABSR :: !Real -> Real;
  180. ABSR x        |    x >= 0.0            = x;
  181.                                     = 0.0 - x;
  182.  
  183.  
  184. /*    Calculation rules on Rectangles:
  185. */
  186.  
  187. RectangleToRect :: !Rectangle -> Rect;
  188. RectangleToRect ((x,y), (x`,y`)) 
  189. |    x_less_x` && y_less_y`    = (x,y,x`,y`);
  190. |    x_less_x`                = (x,y`,x`,y);
  191. |    y_less_y`                = (x`,y,x,y`);
  192.                             = (x`,y`,x,y);
  193.     where {
  194.         x_less_x` = x <= x`;
  195.         y_less_y` = y <= y`;
  196.     }; 
  197.  
  198. IsEmptyRect :: !Rect -> Bool;
  199. IsEmptyRect (0,0,0,0)    = True;
  200. IsEmptyRect _            = False;
  201.  
  202.  
  203. /*    List operations:
  204. */
  205.  
  206. Head :: ![x] -> x;
  207. Head [x : _] = x;
  208.  
  209. Tail :: ![x] -> [x];
  210. Tail [_ : xs] = xs;
  211.  
  212. IsEmptyList :: ![x] -> Bool;
  213. IsEmptyList []     = True;
  214. IsEmptyList _    = False;
  215.  
  216. Reverse :: ![x] [x] -> [x];
  217. Reverse [x : xs] rev = Reverse xs [x : rev];
  218. Reverse _         rev = rev;
  219.  
  220. Concat :: ![x] ![x] -> [x];
  221. Concat [x : xs] ys
  222.     =    let! {
  223.             strict1;
  224.         } in [x : strict1];
  225.     where {
  226.         strict1 = Concat xs ys;
  227.     };
  228. Concat _ ys = ys;
  229.  
  230. Map :: !(x -> y) ![x] -> [y];
  231. Map f [x : xs]
  232.     =    let! {
  233.             f_x;
  234.             map;
  235.         } in [f_x : map];
  236.     where {
  237.         f_x = f x;
  238.         map = Map f xs;
  239.     };
  240. Map _ _ = [];
  241.  
  242. StateMap :: !(x -> .s -> (y, .s)) ![x] .s -> (![y], .s);
  243. StateMap f [x : xs] s
  244.     =    let! {
  245.             f_xs_s1;
  246.             f_x_s;
  247.         } in ([y : ys], s2);
  248.     where {
  249.         f_x_s        = f x s;
  250.         f_xs_s1        = StateMap f xs s1;
  251.         (y,  s1)    = f_x_s;
  252.         (ys, s2)    = f_xs_s1;
  253.     };
  254. StateMap _ _ s = ([], s);
  255.  
  256. StateMap2 :: !(x -> .s -> .s) ![x] !.s -> .s;
  257. StateMap2 f [x : xs] s = StateMap2 f xs (f x s);
  258. StateMap2 _ _ s = s;
  259.  
  260. ::    Cond x :== x -> Bool;
  261.  
  262. Remove :: !(Cond x) x ![x] -> (!Bool, x, ![x]);
  263. Remove c n [x : xs]
  264. |    c x    = (True, x, xs);
  265.         = (b, x`, [x : xs`]);
  266.     where {
  267.         (b, x`, xs`) = Remove c n xs;
  268.     };
  269. Remove _ n xs = (False, n, xs);
  270.  
  271. Append :: ![.x] !.x -> [.x];
  272. Append [x : xs] y
  273.     =    let! {
  274.             xs_y;
  275.         } in [x : xs_y];
  276.     where {
  277.         xs_y = Append xs y;
  278.     };
  279. Append _ y = [y];
  280.  
  281. Length_new :: ![x] -> Int;
  282. Length_new [_ : xs] = inc (Length_new xs);
  283. Length_new _ = 0;
  284.  
  285.  
  286. /*    List operations on Integer lists:
  287. */
  288.  
  289. RemoveCheckInt :: ![Int] !Int -> (!Bool, ![Int]);
  290. RemoveCheckInt [id` : ids] id
  291. |    id == id`    = (True, ids);
  292.                 = (b, [id` : ids`]);
  293.     where {
  294.         (b, ids`) = RemoveCheckInt ids id;
  295.     };
  296. RemoveCheckInt ids _ = (False, ids);
  297.  
  298. ContainsInt :: ![Int] !Int -> Bool;
  299. ContainsInt [c : cs] c`
  300. |    c == c`    = True;
  301.             = ContainsInt cs c`;
  302. ContainsInt _ _ = False;
  303.  
  304.  
  305. //    List operations on Char lists:
  306.  
  307. RemoveChar :: ![Char] !Char -> [Char];
  308. RemoveChar [c : cs] c`
  309. |    c == c`    = cs;
  310.                 = [c : RemoveChar cs c`];
  311. RemoveChar cs _ = cs;
  312.  
  313. ContainsChar :: ![Char] !Char -> Bool;
  314. ContainsChar [c : cs] c`
  315. |    c == c`    = True;
  316.                 = ContainsChar cs c`;
  317. ContainsChar _ _ = False;
  318.  
  319.  
  320. /*    Error generation rule:
  321. */
  322. Error :: !String !String !String -> .x;
  323. Error rule moduleName error
  324.     =    abort ("Error in rule " +++ rule +++ " [" +++ moduleName +++ "]: " +++ error +++ ".\n");
  325.